COMMENT ⊗   VALID 00010 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	SCENE - cross-reference  mapping schemes
C00005 00003	_ LCOMCV, MERGE
C00007 00004	_	Debugging output routines for fail code
C00014 00005	_ XREF
C00016 00006	_	XREF cont
C00019 00007	_	XREF cont
C00022 00008	_	XREF cont.
C00025 00009	_	XREF cont
C00038 00010	_ UNXREF
C00040 ENDMK
C⊗;
COMMENT SCENE - cross-reference  mapping schemes;

ENTRY LCOMCV,XREF,UNXREF;

BEGIN "SCENE"
REQUIRE "⊂⊃||" DELIMITERS;

DEFINE QI=⊂INTEGER⊃,
	QR=⊂REAL⊃,
	QRI=⊂REFERENCE INTEGER⊃,
	QRR=⊂REFERENCE REAL⊃,
	QEP=⊂EXTERNAL SIMPLE PROCEDURE⊃,
	QEIP=⊂EXTERNAL SIMPLE INTEGER PROCEDURE⊃,
	QERP=⊂EXTERNAL SIMPLE REAL PROCEDURE⊃,
	QFOP=⊂FORWARD INTERNAL SIMPLE PROCEDURE⊃,
	QFOIP=⊂FORWARD INTERNAL SIMPLE INTEGER PROCEDURE⊃,
	QFORP=⊂FORWARD INTERNAL SIMPLE REAL PROCEDURE⊃,
	_=⊂COMMENT⊃,
	LOOP(I,J,K,L)=⊂FOR I←J STEP L UNTIL K DO⊃,
	BELCRE(IA)=⊂LVNEXT(IA,-1)⊃,
	SAFEX=⊂SAFE⊃,
	TAB=⊂"	"⊃,
	TAB1=⊂TAB&TAB⊃,
	CRLF=⊂'15&'12⊃,
	INT(A,S)=⊂"  A="&CVS(S)⊃,
	FINT(A,S)=⊂"  A="&CVF(S)⊃,
	BINT(A,S)=⊂"  A="&(IF S THEN "YES" ELSE "NO")⊃,	
	WRITE(S)=⊂IF XTRACE THEN OUT(12,S&CRLF)⊃;

INTEGER IA,IB,IC,ID,IE,LNCS1,LNCS2;
EXTERNAL INTEGER IFREEV,MAXNOL,MAXNOV,LNCRE1,LNCRE2,XTRACE,IDUM,NLPT;
INTERNAL INTEGER I1,IV1,IV2,I2,IX1,IX2,IP1,IP2,IL,ICV1,ICV2,ISV1,ISV2;
INTERNAL REAL R1,R2,RX;
EXTERNAL REAL X, Y, RWIC,RMLE,RCDI,RMALS,RMRLS;
REAL RMLES,RMALSS,RMRLSS,RCDIS,RWICS;

SAFEX EXTERNAL INTEGER ARRAY LCREDE,LVERSI,LVERCO,LVER,IPK,IPS,LINK[1:1];

SAFEX EXTERNAL REAL ARRAY XVCOR,YVCOR,SVANG,XLCOR,YLCOR,RK,RBK,RAS,RBS,
	RCOL,RLEN[1:1];

QEIP ISIGN(QI I,J);
QEIP LVNEXT(QI I,J);
QEIP LVOPP(QI I);
QEIP MERCV(QI I,J,K);
QEIP NLINCV(QI I);
QERP LDIST(QR X,Y; QI I);
QEIP NEXVER;
QEP RETCV(INTEGER ICV);
QEIP LACT(QI I);
QEP ARINT(QRI IPK; QRR RBK,RK,RAS,RBS,RCOL; QRI IPS);
QEP XREF1(QR A,B; QRI LCV1; QR C,D,E,F);
_ LCOMCV, MERGE

_	Returns number of common line, or 0 if no such line.
	Counts all types and connections.;

INTERNAL SIMPLE INTEGER PROCEDURE LCOMCV(INTEGER ICV1,ICV2);
	BEGIN "LCOMCV"
	LABEL L1;
	INTEGER ISV, ISVM;
	ISV←ABS LVNEXT(ICV1,8);
L1:	IF ISV=0 THEN RETURN(0);
	ISVM ← (ISV+1)%2;
	IF LACT(ISVM)∧LVERCO[LVOPP(ISV)]=ICV2 THEN RETURN(ISVM);

_	No, this line is inactive or not common to ICV1 and ICV2, iterate.;

	ISV←ABS LVNEXT(0,8);
	GO L1;
	END "LCOMCV";

QEIP XREF21;
QEIP XREF22;
QEIP XREF30;
QEIP XREF31;
QEIP XREF32;
QEIP XREF41;
QEIP XREF42;
QEIP XREF50;
QEIP XREF52;
QEIP XREF51;
QEP XREF6;
QEIP XREF7;
QEP XREF8;
QEP INNER(QI B1,B2);
QEP CUTJN(BOOLEAN A);
QEP XJOIN(BOOLEAN A);

_	merge CV C1 and C2;

INTERNAL SIMPLE BOOLEAN PROCEDURE MERGE(INTEGER C1, C2, CODE);
	BEGIN
	INTEGER RESULT;
	RESULT ← MERCV(C1,C2,CODE);
	WRITE(|TAB1&"merge "&INT(CV 1,C1)&INT(CV 2,C2)&INT(FLAG,CODE)&
		INT(NEW CV,RESULT)|);
	RETURN(RESULT);
	END;
_	Debugging output routines for fail code;

INTERNAL SIMPLE PROCEDURE DINS(INTEGER V);
	WRITE(TAB1&"line "&CVS(V DIV 2)&" wholely inside line "&
		CVS(IF IDUM=-2 THEN ISV2 DIV 2 ELSE ISV1 DIV 2));

INTERNAL SIMPLE PROCEDURE DCOLIN(INTEGER SV1, SV2);
	WRITE(TAB1&"SV "&CVS(SV1)&" and SV "&CVS(SV2)&" are colinear");

INTERNAL SIMPLE PROCEDURE DEBOUT;
	OUT(12,TAB&INT(SV1,I1)&INT(SV2,I2)&INT(KARN,IDUM)&INT(X1,IP1)&
		INT(X2,IP2)&FINT(D1,R1)&FINT(D2,R2)&CRLF);

INTERNAL SIMPLE PROCEDURE DMINUM(INTEGER V1, V2);
	WRITE(TAB1&"minimum from SV "&CVS(V1)&" to SV "&CVS(ABS V2)&
		(IF V2<0 THEN " - collinear" ELSE NULL));

INTERNAL SIMPLE PROCEDURE DCROSS(INTEGER V1, V2);
	WRITE(TAB1&" vertex "&CVS(V1)&" intersets inside vertex "&CVS(V2));

INTERNAL SIMPLE PROCEDURE DTJOIN(INTEGER CV,SV);
	WRITE(|TAB1&" t-joint: SVs "&CVS(IV1)&" and "&CVS(IV2)&
		INT(SV,SV)&" of "&INT(CV,CV)&" shortened"|);

INTERNAL SIMPLE PROCEDURE DCLEAR(INTEGER SV);
	WRITE(TAB1&"Clear link from SV "&CVS(SV)&" to SV "&CVS(IPS[SV]));

INTERNAL SIMPLE PROCEDURE DCUTJN(INTEGER I2,I3,I4; REAL A1,A2; INTEGER LN);
	WRITE(|TAB&"cut join "&INT(SV1,I1)&INT(SV2,I2)&BINT(1¬BARE,I3)&
		BINT(2¬BARE,I4)&FINT(D1,A1)&FINT(D2,A2)&
		FINT(CD2,RK[I2])&FINT(LEN2,RLEN[LN])|);

INTERNAL SIMPLE PROCEDURE DJOIN1(INTEGER I3; REAL A1);
	WRITE(|TAB&"join "&INT(SV1,I1)&INT(SV2,I3)&FINT(CD1,A1)&
		FINT(D2,RBS[I1])&FINT(CD2,RK[I1])|);

INTERNAL SIMPLE PROCEDURE DJOIN2(INTEGER IS1,IS2);
	WRITE(|TAB1&BINT(1BARE,IS1)&BINT(2BARE,IS2)|);

INTERNAL SIMPLE PROCEDURE DJOIN3(REAL D; INTEGER B1);
		WRITE(|TAB&TAB1&FINT(DIST,D)&BINT(USE RCDIS,B1)|);
_ XREF;

_	Sets up cross-reference tables, based on line intersections,
	and uses those tables as a basis for the creation of temporary
	compound vertices. Those will later be utilized in the object
	abstraction schemes. Collinearities are also recorded as midway-point
	intersections. The program only works with active lines.;

INTERNAL SIMPLE PROCEDURE XREF;
	BEGIN "XREF" LABEL L200;
	INTEGER I3,LCV1,LCV2,PS,LB,IS1,IS2,M1,IS,JS;
	ARINT(IPK[1],RBK[1],RK[1],RAS[1],RBS[1],RCOL[1],IPS[1]);

_	First prepare the distance tables.;

	RX←RMLES←RMLE↑2;
	RMALSS←RMALS↑2;
	RMRLSS←RMRLS↑2;
	RCDIS←RCDI↑2;
	RWICS←RWIC↑2;
	XREF1(RCDIS,RWICS,LCV1,RMLES,RMALSS,RWIC,RMRLSS);
	ARRCLR(RK,900000.);
	ARRCLR(RAS,900000.);
	ARRCLR(RCOL,900000.);
	GETFORMAT(IS,JS);
	SETFORMAT(0,2);
	IF XTRACE THEN
		BEGIN
		OPEN(12,"DSK",0,0,2,I1,I1,I1);
		ENTER(12,"XTRC"&NLPT&".LPT",I1);
		OUTSTR("FILE IS "&NLPT&CRLF);
		NLPT ← NLPT+1;
		END;

_	The following is the MAIN  X-REF SETUP LOOP
	first iteration use RMLE;

	WRITE(|"PASS 0 - ITERATION 0"&FINT(TOLER,RX)|);
	M1 ← MAXNOL-1;
	LOOP(I1,1,M1,1) IF LACT(I1) THEN LOOP(I2,I1+1,MAXNOL,1)
	    IF XREF30 THEN INNER(R1≤RX∧R2≤RX,TRUE);
_	XREF cont;

_	second iteration - amend blocked intersections using RMLE;

	WRITE(|"PASS 0 - ITERATION 1"&FINT(TOLER,RX)|);
	LOOP(I1,1,MAXNOL,1) IF XREF21 THEN LOOP(I2,1,MAXNOL,1)
	    IF XREF31∧¬(IP1≤0∨IP2≤0∨(IP1=1∧¬ICV1)∨(IP1=2∧¬ICV2))∧
		XREF42 THEN INNER(R1≤RX∧R2≤RX,FALSE);

_	CROSS-REFERENCE TABLES NOW EXIST
	Now create temporary vertices and possible T-joints.
	pass 1:	Join acceptable extension-intersections, using RMLE↑2/4
	pass 2:	Same, except use RMLE↑2	;

	PS ← 0;
	FOR RX ← RMLES*.25,RMLES DO
		BEGIN "PASSC"
		PS ← PS+1;
		WRITE(|"PASS "&CVS(PS)&FINT(TOLER,RX)&FINT(RCDIS,RCDIS)&
			FINT(RWIC,RWIC)|);
		LOOP(I1,1,MAXNOV,1) IF XREF50 THEN XJOIN(PS=2);
		END "PASSC";

_	pass 3:	Join ends with small cut stops, iff either end is free,
		     giving preference to shortest RK of line-pair.
	pass 4: Same, except no preference.	;

	FOR PS ← 3,4 DO
		BEGIN "PASSD"
		WRITE(|"PASS "&CVS(PS)&FINT(TOLER,RX)&FINT(RMLES,RMLES)&
			FINT(RMALSS,RMALSS)&FINT(RMRLSS,RMRLSS)|);
		LOOP(I1,1,MAXNOV,1) IF XREF52 THEN CUTJN(PS=3);
		END "PASSD";

_	pass 5:	Join still free ends into closest vertices
		     provided distance and PLDIS are OK.	;

	RX ← RMLES*2;
	WRITE(|"PASS 5"&FINT(TOLER,RX)&FINT(RWICS,RWICS)|);
	LOOP(I1,1,MAXNOV,1) IF XREF51 THEN
		BEGIN "PASSE"
		R1←900000.;
		IP2←LVOPP(I1);
		XREF6;
		END "PASSE";
_	XREF cont;

_	pass 6:  Iterate extension intersections once more, using
			4*RMLE↑2 for sums and new XREF setup	;

	RX ← RMLES*4.;
	WRITE(|"PASS 6"&FINT(TOLER,RX)|);
	M1 ← MAXNOL-1;
	LOOP(I1,1,M1,1) IF XREF22 THEN LOOP(I2,I1+1,MAXNOL,1)
	    IF XREF32∧¬(IP1≤0∨IP2≤0)∧XREF41 THEN INNER((R1+R2)<RX,TRUE);
	LOOP(I1,1,MAXNOV,1) IF XREF51 THEN XJOIN(FALSE);

_	   *****   PRIMARY C.V. COMPOUNDS NOW EXIST   *****;

_	OK, by now all the intersection-indicated c.v:s are created.
	The next step is to merge neighbouring c.v:s, provided they
	are within the maximum distance, CDI, from one another, and
	that a line between them would not cross any other line in
	the topological picture.;

L200:	WRITE("START CV MERGE");
	M1 ← MAXNOV-1;

	LOOP(I1,1,M1,1)
		BEGIN "LP201" 

_		C.v. is active?;

		IF ¬BELCRE(I1) THEN CONTINUE;
		LOOP(I2,I1+1,MAXNOV,1)
			BEGIN "LP202" 

_			Second c.v. is active, as well?;

			IF ¬BELCRE(I2) THEN CONTINUE;

_			Yes, it	 is. Are they close enough?;

			IF XREF7 THEN CONTINUE;
			WRITE(|TAB&" active "&INT(CV 1,I1)&INT(CV 2,I2)&
				"      close enough"|);

_			Yes, they are. Do they have a line in common?;

			IF LCOMCV(I1,I2)≠0 THEN CONTINUE;
			WRITE(TAB1&"no common line");

_			No, they don't. Are they both single?;

			IF NLINCV(-I1)*NLINCV(-I2)=1 THEN CONTINUE;
			WRITE(TAB1&"not both single");
_	XREF cont.;

_			No, they aren't. Does their line-of-sight cross
			any line, in the TOPOLOGICAL picture? Check all
			active lines!;

		 	LOOP(I3,1,MAXNOV,2)
				BEGIN "LP203" 

_				Is the line active?;

				IF ¬LACT("(I3+1)%2") THEN CONTINUE;

_				Yes, it is. Find end c.v:s.;

				ICV1←LVERCO[I3];
				ICV2←LVERCO[I3+1];

_				Does the line belong to our two c.v:s?;

				IF (I1-ICV1)*(I1-ICV2)*(I2-ICV1)*
					(I2-ICV2)=0 THEN CONTINUE;

_				No, it doesn't. Check intersection.;

				XREF8;

_				If the lines cross, we lose. Try next
					second c.v.;

				IF IP1<0∧IP2<0 THEN
					BEGIN
					WRITE(|TAB1&" crossed by "&
					    INT(LINE,I3)|);
					CONTINUE "LP202";
					END;

_				The lines do not cross. Check the next one.;

		 	        END "LP203";

_			All lines are cleared. Merge I1 and I2.;

			IF MERGE(I1,I2,0) THEN GO L200;

_			After a merge, unfortunately, it is necessary to
			iterate all the way back (now or later), but on
			the other hand it won't happen very often!;

			END "LP202";
		END "LP201";
_	XREF cont;

_	Finally check collinearities. Negate links between all active,
	unjoined s.v:s where there are unjoined	crossing lines in between.
	Delete unreciprocated links.;

	WRITE("REDO COLLINEARITIES");
	LOOP(I1,1,MAXNOV,1)
		BEGIN "PASSX"
		INTEGER I3, I4, L1, L2, L3, L4;
		IL←(I1+1)%2;
		IF ¬LACT(IL) THEN CONTINUE;
		I2←ABS LINK[I1];
		IF ¬I2 THEN CONTINUE;
		IF ABS LINK[I2]≠I1 THEN
			BEGIN "PASSY"
			LINK[I1]←0;
			WRITE(|TAB&"delete link "&INT(SV 1,I1)&
				INT(SV 2,I2)|);
			CONTINUE;
			END "PASSY";
		L1 ← LVERCO[I1];
		L2 ← LVERCO[I2];
		IF L1=L2 THEN CONTINUE;
		I3 ← IPK[I1];
		I4 ← IPK[I2];
		IF I3 THEN L3 ← LVERCO[I3];
		IF I4 THEN L4 ← LVERCO[I4];
		R1 ← 4*RCOL[I1];
		IF I3∧RK[I1]<R1∧L1≠L3∨I4∧RK[I2]<R1∧L2≠L4 THEN
			BEGIN "PASSZ"
			LINK[I1]←-I2;
			LINK[I2]←-I1;
			WRITE(|TAB&"crossing line"&INT(SV 1,I1)&
				INT(SV 2,I2)|);
			END "PASSZ";
		END "PASSX";
	IF XTRACE THEN RELEASE(12);
	END "XREF";
_ UNXREF;

_	This procedure disconnects all active lines from each other.
	It assumes no inactive lines are connected to c.v.s containing
	active lines.;

INTERNAL SIMPLE PROCEDURE UNXREF;
	BEGIN "UNXREF"
	LOOP(IA,1,MAXNOL,1) IF LACT(IA) THEN
		BEGIN
		IB←2*IA;
		LOOP(IC,0,1,1)
			BEGIN
			LVER[ID←IB-IC]←ID;
			RETCV(LVERCO[ID]);
			SVANG[ID]←360.;
			END
		END;
	LOOP(IA,1,MAXNOL,1) IF LACT(IA) THEN
		BEGIN
		IB←2*IA;
		LOOP(IC,0,1,1)
			BEGIN
			IE ← NEXVER;
			ID←IB-IC;
			LVERSI[IE]←ID;
			LVERCO[ID]←IE;
			XVCOR[IE]←XLCOR[ID];
			YVCOR[IE]←YLCOR[ID]
			END
		END;
	END "UNXREF";

END "SCENE";